home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / comps / widgets / delphi10 / filicpnl / resunit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-17  |  5.9 KB  |  163 lines
  1. unit Resunit;
  2.  
  3. interface
  4. uses
  5.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  6.   Forms, Dialogs, StdCtrls, ExtCtrls, ShellAPI;
  7.  
  8. procedure GetIconForFile( TheName : String; var TheIcon : TIcon );
  9.  
  10. procedure GetIconForDrive( TheType : Integer; var TheIcon : TIcon );
  11.  
  12. implementation
  13.  
  14. {$R FIP.RES}                 { Import custom resource file }
  15.  
  16. procedure GetIconForDrive( TheType : Integer; var TheIcon : TIcon );
  17. var TheExt           : String; { File extension holder }
  18.     TheOtherPChar  ,           { Windows ASCIIZ string }
  19.     TheResultPChar ,           { Windows ASCIIZ string }
  20.     ThePChar         : PChar;  { Windows ASCIIZ string }
  21. begin
  22.   { Use the data field value to determine which icon to get from RES file }
  23.   case TheType of
  24.     1 : begin
  25.           GetMem( TheOtherPChar , 255 );
  26.           StrPCopy( TheOtherPChar , 'FLOPPY35' );
  27.           TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  28.           FreeMem( TheOtherPChar , 255 );
  29.         end;
  30.     2 : begin
  31.           GetMem( TheOtherPChar , 255 );
  32.           StrPCopy( TheOtherPChar , 'FIXEDHD' );
  33.           TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  34.           FreeMem( TheOtherPChar , 255 );
  35.         end;
  36.     3 : begin
  37.           GetMem( TheOtherPChar , 255 );
  38.           StrPCopy( TheOtherPChar , 'NETWORKHD' );
  39.           TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  40.           FreeMem( TheOtherPChar , 255 );
  41.         end;
  42.     4 : begin
  43.           GetMem( TheOtherPChar , 255 );
  44.           StrPCopy( TheOtherPChar , 'CDROM' );
  45.           TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  46.           FreeMem( TheOtherPChar , 255 );
  47.         end;
  48.     5 : begin
  49.           GetMem( TheOtherPChar , 255 );
  50.           StrPCopy( TheOtherPChar , 'RAM' );
  51.           TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  52.           FreeMem( TheOtherPChar , 255 );
  53.         end;
  54.   end;
  55. end;
  56.  
  57. { This procedure gets an icon for a file using FindExecutable  }
  58. { and ExtractIcon. (assumes file/dir is passed)                }
  59. procedure GetIconForFile( TheName : String; var TheIcon : TIcon );
  60. var TheExt           : String; { File extension holder }
  61.     TheOtherPChar  ,           { Windows ASCIIZ string }
  62.     TheResultPChar ,           { Windows ASCIIZ string }
  63.     ThePChar         : PChar;  { Windows ASCIIZ string }
  64. begin
  65.   if TheName = 'NO FILE' then
  66.   begin
  67.     GetMem( TheOtherPChar , 255 );
  68.     StrPCopy( TheOtherPChar , 'NOICON' );
  69.     TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  70.     FreeMem( TheOtherPChar , 255 );
  71.     exit;
  72.   end;
  73.   { Check for directory and if so get directory icon from RES file }
  74.   if (( FileGetAttr( TheName ) and faDirectory ) = faDirectory ) then
  75.   begin
  76.     { Set up the PChar to communicate with Windows }
  77.     GetMem( TheOtherPChar , 255 );
  78.     { Convert Pascal-style string to ASCIIZ Pchar }
  79.     StrPCopy( TheOtherPChar , 'DIRECTORY' );
  80.     { Use API call to return icon handle of Icon Resource in FILECTRL.RES }
  81.     TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  82.     { Release memory from PChar }
  83.     FreeMem( TheOtherPChar , 255 );
  84.     { Leave }
  85.     exit;
  86.   end;
  87.   { Assume archive file; get its extension }
  88.   TheExt := Uppercase( ExtractFileExt( TheName ));
  89.   { If not an executable/image file then use FindExecutable to get icon }
  90.   if (( TheExt <> '.EXE' ) and ( TheExt <> '.BAT' ) and
  91.       ( TheExt <> '.PIF' ) and ( TheExt <> '.COM' )) then
  92.   begin
  93.     { Grab three chunks of memory }
  94.     GetMem( TheOtherPChar , 255 );
  95.     GetMem( TheResultPChar , 255 );
  96.     GetMem( ThePChar , 255 );
  97.     { Set up the name and its directory in Windows string formats }
  98.     StrPCopy( ThePChar, TheName );
  99.     StrPCopy( TheOtherPChar , ExtractFilePath( TheName ));
  100.     { Use FindExecutable API call to get path and name of owning file }
  101.     if FindExecutable( ThePChar , TheOtherPChar , TheResultPChar ) > 31 then
  102.     begin
  103.       { If get a result of 32 or more then try to get first icon of owner }
  104.       { Using ExtractIcon API call; 0 indicates first icon.               }
  105.       TheIcon.Handle := ExtractIcon( hInstance , TheResultPchar , 0 );
  106.       { If a handle is 0 then no icon in owner, get default icon from RES file }
  107.       if TheIcon.Handle = 0 then
  108.       begin
  109.         GetMem( TheOtherPChar , 255 );
  110.         StrPCopy( TheOtherPChar , 'NOICON' );
  111.         TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  112.         FreeMem( TheOtherPChar , 255 );
  113.         exit;
  114.       end;
  115.     end
  116.     else
  117.     { if no assigned executable, then get default icon from RES file }
  118.     begin
  119.       GetMem( TheOtherPChar , 255 );
  120.       StrPCopy( TheOtherPChar , 'NOICON' );
  121.       TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  122.       FreeMem( TheOtherPChar , 255 );
  123.       exit;
  124.     end;
  125.     FreeMem( TheOtherPChar , 255 );
  126.     FreeMem( TheResultPChar , 255 );
  127.     FreeMem( ThePChar , 255 );
  128.   end
  129.   else
  130.   { Assume Windows Executable file, so get icon from it with ExtractIcon API }
  131.   begin
  132.     GetMem( ThePChar , 255 );
  133.     StrPCopy( ThePChar , TheName );
  134.     { If no icons in file then get default icon (note use FFFF for -1) }
  135.     if ExtractIcon( hInstance , ThePchar , 65535 ) = 0 then
  136.     begin
  137.       Freemem( ThePChar , 255 );
  138.       GetMem( TheOtherPChar , 255 );
  139.       StrPCopy( TheOtherPChar , 'NOICON' );
  140.       TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  141.       FreeMem( TheOtherPChar , 255 );
  142.       exit;
  143.     end
  144.     else
  145.     begin
  146.       { Try to get first icon for file }
  147.       TheIcon.Handle := ExtractIcon( hInstance , ThePChar , 0 );
  148.       FreeMem( ThePChar , 255 );
  149.       { If handle is 0 invalid icon format so use default from RES file }
  150.       if TheIcon.Handle = 0 then
  151.       begin
  152.         GetMem( TheOtherPChar , 255 );
  153.         StrPCopy( TheOtherPChar , 'NOICON' );
  154.         TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  155.         FreeMem( TheOtherPChar , 255 );
  156.         exit;
  157.       end;
  158.     end;
  159.   end;
  160. end;
  161.  
  162. end.
  163.